home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / RTX2000.ZIP / rtx2000 / monitor / util < prev   
Text File  |  1992-11-01  |  2KB  |  106 lines
  1. ( **************************** MODULE UTIL ****************************** 
  2.      Utilities
  3. )
  4.  
  5.  
  6. xlink
  7. : newline ( -- )
  8. ( Send new line to terminal )
  9.    CR emit LF emit
  10. ;
  11.  
  12. xlink
  13. : toupper ( c -- c )
  14. ( Forces character to upper case )
  15.     dup 0x61 u>= if
  16.       0x20 -             ( Lower case to uppercase )
  17.     then
  18. ;
  19.  
  20. xlink
  21. : .x   ( n -- )
  22. ( Print a hex number followed by a space )
  23.    4 for
  24.      dup 0xF and
  25.      dup 10 u>= if
  26.         7 +          ( Adjust for A-F )
  27.      then   
  28.      0x30 +            
  29.      swap  4>>       ( Next nibble )
  30.    next
  31.    drop
  32.    emit emit emit emit
  33.    0x20 emit         ( print a space )
  34. ;
  35.  
  36. : skip_space ( a -- a )
  37. ( Skips past any spaces in the array pointer by the input )
  38.    begin
  39.       c@+ swap
  40.       0x20 -
  41.    until
  42.    1 -
  43. ;
  44.  
  45. xlink
  46. : emit_string ( a -- )
  47. ( Output string pointed by a )
  48.    c@+ swap
  49.    for
  50.       c@+ swap emit
  51.    next
  52.    drop
  53. ;
  54.  
  55. : do_nibble ( n c o -- n f )
  56. ( Subtract offset o from c, incorporate it into number n, append FALSE )
  57.    - swap 4<< or FALSE
  58. ;
  59.  
  60. : do_digit ( n c -- n f )
  61. ( If c is a valid hex digit, incorporate it into number n and return FALSE
  62.   otherwise n not changed and TRUE returned )
  63.    dup 0x30 u>= if
  64.       dup 0x46 u<= if
  65.          dup 0x40 u>= if
  66.             dup 0x40 u<= if
  67.                drop TRUE
  68.             else
  69.                0x37 do_nibble
  70.             then
  71.          else
  72.             0x30 do_nibble
  73.          then
  74.       else
  75.          drop TRUE
  76.       then
  77.    else
  78.       drop TRUE
  79.    then
  80. ;
  81.    
  82. : getnum ( a -- n a  )
  83. ( Get a number from the buffer address a , returns zero if none available 
  84. advances to first invalid hex digit )
  85.    skip_space                ( Skip spaces )
  86.    0
  87.    begin
  88.       swap
  89.       c@+  -rot               ( Get a char )
  90.       do_digit                ( Fold it into the number )
  91.    until                      ( Repeat until invalid hex digit )
  92.    swap
  93.    1 - 
  94. ;
  95.  
  96. : cpy_ram_ram  ( d s c -- )
  97. ( Copy RAM to RAM, c=word count, s=source addr, d=destination addr )
  98.   for
  99.     @+
  100.     swap rot
  101.     !+ swap
  102.   next
  103.   drop drop
  104. ;
  105.  
  106.